www.gusucode.com > 威博多用户网上购物商城(生成html) 6 > 威博多用户网上购物商城(生成html) 6.2/威博多用户/editor/Include/ReplaceRemoteUrl.asp
<% '================================================ '作 用:替换字符串中的远程文件为本地文件并保存远程文件 '参 数: ' sHTML : 要替换的字符串 ' sSavePath : 保存文件的路径 ' sExt : 执行替换的扩展名 '================================================ Function eWebEditor_ReplaceRemoteUrl(sHTML, sSavePath, sExt) Dim s_Content s_Content = sHTML If eWebEditor_IsObjInstalled("Microsoft.XMLHTTP") = False then eWebEditor_ReplaceRemoteUrl = s_Content Exit Function End If If sSavePath = "" Then sSavePath = "/eWebEditor/UploadFile/" If sExt = "" Then sExt = "jpg|gif|bmp|png" Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType, ranNum Set re = new RegExp re.IgnoreCase = True re.Global = True re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))" Set RemoteFile = re.Execute(s_Content) For Each RemoteFileurl in RemoteFile SaveFileType = Mid(RemoteFileurl, InstrRev(RemoteFileurl, ".") + 1) Randomize ranNum = Int(900 * Rnd) + 100 SaveFileName = sSavePath & year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & ranNum & "." & SaveFileType Call eWebEditor_SaveRemoteFile(SaveFileName, RemoteFileurl) s_Content = Replace(s_Content,RemoteFileurl,SaveFileName) Next eWebEditor_ReplaceRemoteUrl = s_Content End Function '================================================ '作 用:保存远程的文件到本地 '参 数:LocalFileName ------ 本地文件名 ' RemoteFileUrl ------ 远程文件URL '返回值:True ----成功 ' False ----失败 '================================================ Sub eWebEditor_SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl) Dim Ads, Retrieval, GetRemoteData On Error Resume Next Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", s_RemoteFileUrl, False, "", "" .Send GetRemoteData = .ResponseBody End With Set Retrieval = Nothing Set Ads = Server.CreateObject("Adodb.Stream") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(s_LocalFileName), 2 .Cancel() .Close() End With Set Ads=nothing End Sub '================================================ '作 用:检查组件是否已经安装 '参 数:strClassString ----组件名 '返回值:True ----已经安装 ' False ----没有安装 '================================================ Function eWebEditor_IsObjInstalled(s_ClassString) On Error Resume Next eWebEditor_IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(s_ClassString) If 0 = Err Then eWebEditor_IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function %>